home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / efs / efs-cms-knet.el.z / efs-cms-knet.el
Encoding:
Text File  |  1998-05-21  |  8.4 KB  |  246 lines
  1. ;; -*-Emacs-Lisp-*-
  2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3. ;;
  4. ;; File:         efs-cms-knet.el
  5. ;; Release:      $efs release: 1.15 $
  6. ;; Version:      #Revision: 1.1 $
  7. ;; RCS:          
  8. ;; Description:  CMS support for efs using KNET/VM server
  9. ;; Authors:     Sandy Rutherford <sandy@ibm550.sissa.it>
  10. ;;               Joerg-Martin Schwarz <schwarz@hal1.physik.uni-dortmund.de>
  11. ;; Created:      Wed Mar 23 14:39:00 1994 by schwarz on hal1 from efs-cms.el
  12. ;; Modified:     Sun Nov 27 11:45:58 1994 by sandy on gandalf
  13. ;; Language:     Emacs-Lisp
  14. ;;
  15. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  16.  
  17. ;;; This file is part of efs. See efs.el for copyright
  18. ;;; (it's copylefted) and warrranty (there isn't one) information.
  19.  
  20. (provide 'efs-cms-knet)
  21. (require 'efs)
  22.  
  23. (defconst efs-cms-knet-version
  24.   (concat (substring "$efs release: 1.15 $" 14 -2)
  25.       "/"
  26.       (substring "#Revision: 1.1 $" 11 -2)))
  27.  
  28. ;;;; ------------------------------------------------------------
  29. ;;;; CMS support for KNET-VM server
  30. ;;;; ------------------------------------------------------------
  31.  
  32. ;;; efs has full support, including tree dired support, for hosts running
  33. ;;; CMS.  It should be able to automatically recognize any CMS machine.
  34. ;;; We would be grateful if you would report any failures to automatically
  35. ;;; recognize a CMS host as a bug.
  36. ;;; 
  37. ;;; Filename syntax:
  38. ;;;
  39. ;;; KNET/VM Support (J. M. Schwarz, Mar 12, 1994):
  40. ;;; This code has been developed and tested with 
  41. ;;; "KNET/VM FTP server Release 3.2.0" by Spartacus.
  42. ;;;
  43. ;;; This server uses not only a different listing format than the one used in
  44. ;;; efs-cms.el, but also handles minidisks differently. 
  45. ;;; The cd command for changing minidisk is not supported, 
  46. ;;; instead a full filename syntax "FILENAME.FILETYPE.FM" is used, where
  47. ;;; FM is the filemode. To access a file "PROFILE EXEC A0", efs uses a
  48. ;;; syntax "/cms-hostname:/A:/PROFILE.EXEC"   (Note the ':')
  49. ;;; 
  50. ;;; In this directory notation, "/A0:" is actually a subset of the "/A:"
  51. ;;; directory.
  52.  
  53. (efs-defun efs-send-pwd cms-knet (host user &optional xpwd)
  54.   ;; cms-knet has no concept of current directory.
  55.   ;; Is it safe to always assume this is the user's home?
  56.   (cons "A" ""))
  57.  
  58. (efs-defun efs-fix-path cms-knet (path &optional reverse)
  59.   ;; Convert PATH from UNIX-ish to CMS. If REVERSE is given, convert
  60.   ;; from CMS to UNIX. Actually, CMS doesn't have a full pathname syntax,
  61.   ;; so we fudge things by sending cd's.
  62.   (if reverse
  63.       ;; Since we only convert output from a pwd in this direction,
  64.       ;; this should never be applied, as PWD doesn't work for this server.
  65.       (concat "/" path "/")
  66.     (efs-save-match-data
  67.       (if (string-match "^/[A-Z]/\\([-A-Z0-9$_+@:]+\\.[-A-Z0-9$_+@:]+\\)$"
  68.             path)
  69.       (concat
  70.        (substring path (match-beginning 1) (match-end 1))
  71.        "."
  72.        ;; minidisk
  73.        (substring path 1 2))
  74.     (error "Invalid CMS-KNET filename")))))
  75.  
  76. (efs-defun efs-fix-dir-path cms-knet (dir-path)
  77.   ;; Convert path from UNIX-ish to CMS-KNET ready for a DIRectory listing.
  78.   (cond
  79.    ((string-equal "/" dir-path)
  80.     "*.*.*")
  81.    ((string-match
  82.      "^/[A-Z]/\\([-A-Z0-9$._+@:]+\\.[-A-Z0-9$._+@:]+\\)?$"
  83.      dir-path)
  84.     (concat 
  85.      (if (match-beginning 1)
  86.      (substring dir-path (match-beginning 1) (match-end 1))
  87.        "*")
  88.      "."
  89.      (substring dir-path 1 2)))
  90.    (t (error "Invalid CMS-KNET pathname"))))
  91.  
  92. (defconst efs-cms-knet-file-name-regexp
  93.   (concat
  94.    "^  *\\([-A-Z0-9$_+@:]+\\) +\\([-A-Z0-9$_+@:]+\\) +"
  95.    "\\([A-Z]\\)[0-9] +[VF] +[0-9]+ "))
  96.  
  97. (efs-defun efs-parse-listing cms-knet
  98.   (host user dir path &optional switches)
  99.   ;; Parse the current buffer which is assumed to be a CMS directory listing.
  100.   ;; HOST = remote host name
  101.   ;; USER = remote user name
  102.   ;; DIR = directory as a full remote path
  103.   ;; PATH = directory as a full efs-path
  104.   (let ((tbl (efs-make-hashtable)))
  105.     (goto-char (point-min))
  106.     (efs-save-match-data
  107.       (if (string-equal dir "/")
  108.       (let ((case-fold (memq 'cms-knet efs-case-insensitive-host-types))
  109.         tbl-alist md md-tbl)
  110.         (while (re-search-forward efs-cms-knet-file-name-regexp nil t)
  111.           (setq md (buffer-substring (match-beginning 3) (match-end 3))
  112.             md-tbl (or (cdr (assoc md tbl-alist))
  113.                    (let ((new-tbl (efs-make-hashtable)))
  114.                  (setq tbl-alist
  115.                        (cons (cons md new-tbl)
  116.                          tbl-alist))
  117.                  new-tbl)))
  118.           (efs-put-hash-entry md '(t) tbl)
  119.           (efs-put-hash-entry (concat
  120.                    (buffer-substring (match-beginning 1)
  121.                              (match-end 1))
  122.                    "."
  123.                    (buffer-substring (match-beginning 2)
  124.                              (match-end 2)))
  125.                   '(nil) md-tbl)
  126.           (forward-line 1))
  127.         (while tbl-alist
  128.           (setq md (car (car tbl-alist))
  129.             md-tbl (cdr (car tbl-alist)))
  130.           (efs-put-hash-entry "." '(t) md-tbl)
  131.           (efs-put-hash-entry ".." '(t) md-tbl)
  132.           (efs-put-hash-entry (concat path md "/") md-tbl
  133.                   efs-files-hashtable case-fold)
  134.           (setq tbl-alist (cdr tbl-alist))))
  135.     (while (re-search-forward efs-cms-knet-file-name-regexp nil t)
  136.       (efs-put-hash-entry
  137.        (concat (buffer-substring (match-beginning 1)
  138.                      (match-end 1))
  139.            "."
  140.            (buffer-substring (match-beginning 2)
  141.                      (match-end 2)))
  142.        '(nil) tbl)
  143.       (forward-line 1)))
  144.       (efs-put-hash-entry "." '(t) tbl)
  145.       (efs-put-hash-entry ".." '(t) tbl))
  146.     tbl))
  147.  
  148. (efs-defun efs-allow-child-lookup cms-knet (host user dir file)
  149.   ;; Returns t if FILE in directory DIR could possibly be a subdir
  150.   ;; according to its file-name syntax, and therefore a child listing should
  151.   ;; be attempted.
  152.   
  153.   ;; CMS file system is flat. Only minidisks are "subdirs".
  154.   (string-equal "/" dir))
  155.  
  156. ;;; Tree dired support:
  157.  
  158. (defconst efs-dired-cms-re-exe
  159.   "^. +[-A-Z0-9$_+@:]+ +\\(EXEC\\|MODULE\\) "
  160.   "Regular expression to use to search for CMS executables.")
  161.  
  162. (or (assq 'cms efs-dired-re-exe-alist)
  163.     (setq efs-dired-re-exe-alist
  164.       (cons (cons 'cms-knet efs-dired-cms-re-exe)
  165.         efs-dired-re-exe-alist)))
  166.  
  167. (efs-defun efs-dired-insert-headerline cms-knet (dir)
  168.   ;; CMS has no total line, so we insert a blank line for
  169.   ;; aesthetics.
  170.   (insert "\n")
  171.   (forward-char -1)
  172.   (efs-real-dired-insert-headerline dir))
  173.  
  174. (efs-defun efs-dired-manual-move-to-filename cms-knet
  175.   (&optional raise-error bol eol)
  176.   ;; In dired, move to the first char of filename on this line.
  177.   ;; This is the CMS version.
  178.   (or eol (setq eol (save-excursion (skip-chars-forward "^\n\r") (point))))
  179.   (let (case-fold-search)
  180.     (if bol
  181.     (goto-char bol)
  182.       (skip-chars-backward "^\n\r")
  183.       (setq bol (point)))
  184.     (if (re-search-forward efs-cms-knet-file-name-regexp eol t)
  185.     (goto-char (match-beginning 1))
  186.       (if raise-error
  187.       (error "No file on this line.")
  188.     (goto-char bol)))))
  189.  
  190. (efs-defun efs-dired-manual-move-to-end-of-filename cms-knet
  191.   (&optional no-error bol eol)
  192.   ;; Assumes point is at beginning of filename.
  193.   ;; So, it should be called only after (dired-move-to-filename t).
  194.   ;; case-fold-search must be nil, at least for VMS.
  195.   ;; On failure, signals an error or returns nil.
  196.   ;; This is the CMS version.
  197.   (and selective-display
  198.        (null no-error)
  199.        (eq (char-after
  200.         (1- (or bol (save-excursion
  201.               (skip-chars-backward "^\r\n")
  202.               (point)))))
  203.        ?\r)
  204.        ;; File is hidden or omitted.
  205.        (cond
  206.     ((dired-subdir-hidden-p (dired-current-directory))
  207.      (error
  208.       (substitute-command-keys
  209.        "File line is hidden. Type \\[dired-hide-subdir] to unhide.")))
  210.     ((error
  211.       (substitute-command-keys
  212.        "File line is omitted. Type \\[dired-omit-toggle] to un-omit."
  213.        )))))
  214.   (if (looking-at "[-A-Z0-9$_+@:]+ +[-A-Z0-9$_+@:]+ +[A-Z][0-9] ")
  215.       (goto-char (- (match-end 0) 2)) ; return point
  216.     (if no-error
  217.     nil
  218.       (error "No file on this line."))))
  219.  
  220. (efs-defun efs-dired-get-filename cms-knet
  221.   (&optional localp no-error-if-not-filep)
  222.   (let ((name (efs-real-dired-get-filename 'no-dir no-error-if-not-filep)))
  223.     (and name
  224.      (if (string-match
  225.           "^\\([-A-Z0-9$_+@:]+\\) +\\([-A-Z0-9$_+@:]+\\) +\\([A-Z]\\)$"
  226.           name)
  227.          (let* ((dir (dired-current-directory))
  228.             (rdir (nth 2 (efs-ftp-path dir))))
  229.            (setq name (concat (substring name (match-beginning 1)
  230.                          (match-end 1))
  231.                   "."
  232.                   (substring name (match-beginning 2)
  233.                          (match-end 2))))
  234.            (if (string-equal rdir "/")
  235.            (setq name (concat (substring name (match-beginning 3)
  236.                          (match-end 3)) "/" name)))
  237.            (if (eq localp 'no-dir)
  238.            name
  239.          (concat (if localp
  240.                  (dired-current-directory localp)
  241.                dir)
  242.              name)))
  243.        (error "Strange CMS-KNET file name %s" name)))))
  244.  
  245. ;;; end of efs-cms-knet.el
  246.